home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / scm / xscm.lha / xscm / xgen.scm < prev    next >
Encoding:
Text File  |  1992-08-29  |  6.5 KB  |  131 lines
  1. ; $Header: /home/campbell/Languages/Scheme/scm/x-scm/RCS/xgen.scm,v 1.1 1992/07/03 03:06:52 campbell Beta $
  2. ;
  3. ; This module generates two files, xevent.scm and xevent.h, that
  4. ; define the correspondence between Scheme identifiers for X structure
  5. ; fields and the C code required to fetch them and turn them into Scheme
  6. ; values.
  7. ;
  8. ;  Author: Larry Campbell (campbell@redsox.bsw.com)
  9. ; 
  10. ;  Copyright 1992 by The Boston Software Works, Inc.
  11. ;  Permission to use for any purpose whatsoever granted, as long
  12. ;  as this copyright notice remains intact.  Please send bug fixes
  13. ;  or enhancements to the above email address.
  14.  
  15. (require 'stdio)
  16.  
  17. (define x::event-map-table
  18.   '(
  19.     (x:any-event:type        "MAKINUM(((XAnyEvent *) x)->type)")
  20.     (x:any-event:serial        "MAKINUM(((XAnyEvent *) x)->serial)")
  21.     (x:any-event:send-event    "x_make_bool(((XAnyEvent *) x)->send_event)")
  22.  
  23.     (x:key-event:type        "MAKINUM(((XKeyEvent *) x)->type)")
  24.     (x:key-event:serial        "MAKINUM(((XKeyEvent *) x)->serial)")
  25.     (x:key-event:send-event    "x_make_bool(((XKeyEvent *) x)->send_event)")
  26.     (x:key-event:time        "MAKINUM(((XKeyEvent *) x)->time)")
  27.     (x:key-event:x        "MAKINUM(((XKeyEvent *) x)->x)")
  28.     (x:key-event:y        "MAKINUM(((XKeyEvent *) x)->y)")
  29.     (x:key-event:x-root        "MAKINUM(((XKeyEvent *) x)->x_root)")
  30.     (x:key-event:y-root        "MAKINUM(((XKeyEvent *) x)->y_root)")
  31.     (x:key-event:state        "MAKINUM(((XKeyEvent *) x)->state)")
  32.     (x:key-event:keycode    "MAKINUM(((XKeyEvent *) x)->keycode)")
  33.     (x:key-event:same-screen    "x_make_bool(((XKeyEvent *) x)->same_screen)")
  34.  
  35.     (x:button-event:type    "MAKINUM(((XButtonEvent *) x)->type)")
  36.     (x:button-event:serial    "MAKINUM(((XButtonEvent *) x)->serial)")
  37.     (x:button-event:send-event    "x_make_bool(((XButtonEvent *) x)->send_event)")
  38.     (x:button-event:time    "MAKINUM(((XButtonEvent *) x)->time)")
  39.     (x:button-event:x        "MAKINUM(((XButtonEvent *) x)->x)")
  40.     (x:button-event:y        "MAKINUM(((XButtonEvent *) x)->y)")
  41.     (x:button-event:x-root    "MAKINUM(((XButtonEvent *) x)->x_root)")
  42.     (x:button-event:y-root    "MAKINUM(((XButtonEvent *) x)->y_root)")
  43.     (x:button-event:state    "MAKINUM(((XButtonEvent *) x)->state)")
  44.     (x:button-event:button    "MAKINUM(((XButtonEvent *) x)->button)")
  45.     (x:button-event:same-screen    "x_make_bool(((XButtonEvent *) x)->same_screen)")
  46.  
  47.     (x:motion-event:type    "MAKINUM(((XMotionEvent *) x)->type)")
  48.     (x:motion-event:serial    "MAKINUM(((XMotionEvent *) x)->serial)")
  49.     (x:motion-event:send-event    "x_make_bool(((XMotionEvent *) x)->send_event)")
  50.     (x:motion-event:time    "MAKINUM(((XMotionEvent *) x)->time)")
  51.     (x:motion-event:x        "MAKINUM(((XMotionEvent *) x)->x)")
  52.     (x:motion-event:y        "MAKINUM(((XMotionEvent *) x)->y)")
  53.     (x:motion-event:x-root    "MAKINUM(((XMotionEvent *) x)->x_root)")
  54.     (x:motion-event:y-root    "MAKINUM(((XMotionEvent *) x)->y_root)")
  55.     (x:motion-event:state    "MAKINUM(((XMotionEvent *) x)->state)")
  56.     (x:motion-event:is-hint    "MAKINUM(((XMotionEvent *) x)->is_hint)")
  57.     (x:motion-event:same-screen    "x_make_bool(((XMotionEvent *) x)->same_screen)")
  58.  
  59.     (x:crossing-event:type    "MAKINUM(((XCrossingEvent *) x)->type)")
  60.     (x:crossing-event:serial    "MAKINUM(((XCrossingEvent *) x)->serial)")
  61.     (x:crossing-event:send-event "x_make_bool(((XCrossingEvent *) x)->send_event)")
  62.     (x:crossing-event:time    "MAKINUM(((XCrossingEvent *) x)->time)")
  63.     (x:crossing-event:x        "MAKINUM(((XCrossingEvent *) x)->x)")
  64.     (x:crossing-event:y        "MAKINUM(((XCrossingEvent *) x)->y)")
  65.     (x:crossing-event:x-root    "MAKINUM(((XCrossingEvent *) x)->x_root)")
  66.     (x:crossing-event:y-root    "MAKINUM(((XCrossingEvent *) x)->y_root)")
  67.     (x:crossing-event:mode    "MAKINUM(((XCrossingEvent *) x)->mode)")
  68.     (x:crossing-event:detail    "MAKINUM(((XCrossingEvent *) x)->detail)")
  69.     (x:crossing-event:same-screen "x_make_bool(((XCrossingEvent *) x)->same_screen)")
  70.     (x:crossing-event:focus    "x_make_bool(((XCrossingEvent *) x)->focus)")
  71.     (x:crossing-event:state    "x_make_bool(((XCrossingEvent *) x)->state)")
  72.  
  73.     (x:focus-change-event:type    "MAKINUM(((XFocusChangeEvent *) x)->type)")
  74.     (x:focus-change-event:serial "MAKINUM(((XFocusChangeEvent *) x)->serial)")
  75.     (x:focus-change-event:send-event "x_make_bool(((XFocusChangeEvent *) x)->send_event)")
  76.     (x:focus-change-event:mode    "MAKINUM(((XFocusChangeEvent *) x)->mode)")
  77.     (x:focus-change-event:detail "MAKINUM(((XFocusChangeEvent *) x)->detail)")
  78.  
  79.     (x:keymap-event:type    "MAKINUM(((XKeymapEvent *) x)->type)")
  80.     (x:keymap-event:serial    "MAKINUM(((XKeymapEvent *) x)->serial)")
  81.     (x:keymap-event:send-event    "x_make_bool(((XKeymapEvent *) x)->send_event)")
  82.  
  83.     (x:expose-event:type    "MAKINUM(((XExposeEvent *) x)->type)")
  84.     (x:expose-event:serial    "MAKINUM(((XExposeEvent *) x)->serial)")
  85.     (x:expose-event:send-event    "x_make_bool(((XExposeEvent *) x)->send_event)")
  86.     (x:expose-event:x        "MAKINUM(((XExposeEvent *) x)->x)")
  87.     (x:expose-event:y        "MAKINUM(((XExposeEvent *) x)->y)")
  88.     (x:expose-event:width    "MAKINUM(((XExposeEvent *) x)->width)")
  89.     (x:expose-event:height    "MAKINUM(((XExposeEvent *) x)->height)")
  90.     (x:expose-event:count    "MAKINUM(((XExposeEvent *) x)->count)")
  91.  
  92.     (x:graphics-expose-event:type    "MAKINUM(((XGraphicsExposeEvent *) x)->type)")
  93.     (x:graphics-expose-event:serial    "MAKINUM(((XGraphicsExposeEvent *) x)->serial)")
  94.     (x:graphics-expose-event:send-event    "x_make_bool(((XGraphicsExposeEvent *) x)->send_event)")
  95.     (x:graphics-expose-event:x        "MAKINUM(((XGraphicsExposeEvent *) x)->x)")
  96.     (x:graphics-expose-event:y        "MAKINUM(((XGraphicsExposeEvent *) x)->y)")
  97.     (x:graphics-expose-event:width    "MAKINUM(((XGraphicsExposeEvent *) x)->width)")
  98.     (x:graphics-expose-event:height    "MAKINUM(((XGraphicsExposeEvent *) x)->height)")
  99.     (x:graphics-expose-event:count    "MAKINUM(((XGraphicsExposeEvent *) x)->count)")
  100.  
  101.      ))
  102.  
  103. (define (x::generate-c-code f)
  104.   (fprintf f "/* This file generated by xgen.scm -- do NOT edit it! */\\n")
  105.   (let ((index 0))
  106.     (for-each
  107.      (lambda (item)
  108.        (let ((sname (car item))
  109.          (ccode (cadr item)))
  110.      (fprintf f "    case %d: return %s;\\n" index ccode)
  111.      (set! index (1+ index))))
  112.      x::event-map-table)))
  113.  
  114. (define (x::generate-scheme-code f)
  115.   (fprintf f ";;; This file generated by xgen.scm -- do NOT edit it!\\n")
  116.   (let ((index 0))
  117.     (for-each
  118.      (lambda (item)
  119.        (let ((sname (car item))
  120.          (ccode (cadr item)))
  121.      (fprintf f "(define ")
  122.      (write sname f)
  123.      (fprintf f "  %d)\\n" index)
  124.      (set! index (1+ index))))
  125.      x::event-map-table)))
  126.  
  127. (call-with-output-file "xevent.h" x::generate-c-code)
  128. (call-with-output-file "xevent.scm" x::generate-scheme-code)
  129.  
  130. (quit)
  131.